Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue44/HTMLmove/Sprites.pas

Pascal/Delphi Source File | 1997-08-28 | 6.5 KB | 249 lines

{ *****************************************************
                         ThgSprite Component

  This component is a sprite for quick animations such as
  bouncing logo's etc.

  TCustomSprite is an abstract base class to descend other
  sprites from.

  TSprite is a TCustomSprite descendant which publishes the
  AND and OR bitmaps so the user can set then at design
  time.

                  Paul Warren
         HomeGrown Software Development
       (c) 1996 Langley British Columbia.
                [phone]
         e-mail:  [e-mail]
    Home page: http://haven.uniserve.com/~hg_soft
  ***************************************************** }

unit Sprites;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TCustomSprite = class(TGraphicControl)
  private
    { private declarations }
    FAndImage: TBitmap;
    FOrImage: TBitmap;
    procedure SetAndImage(AAndImage: TBitmap);
    procedure SetOrImage(AOrImage: TBitmap);
  protected
    { protected declarations }
    procedure Paint; override;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure MoveSprite; virtual; abstract;
    property AndImage: TBitmap read FAndImage write SetAndImage;
    property OrImage: TBitmap read FOrImage write SetOrImage;
  published
    { published declarations }
  end;

  TSpriteMoveEvent = procedure(Sender: TObject;
      var Bounds: TRect) of object;

  TSprite = class(TCustomSprite)
  private
    { private declarations }
    FSLeft: integer;
    FSTop: integer;
    FVX, FVY: integer;
    FOnMove: TSpriteMoveEvent;
    FOnBounce: TNotifyEvent;
    procedure SetVX(Value: integer);
    procedure SetVY(Value: integer);
    procedure SetOnMove(Value: TSpriteMoveEvent);
    procedure SetOnBounce(Value: TNotifyEvent);
  protected
    { protected declarations }
    procedure Paint; override;
    procedure Loaded; override;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure MoveSprite; override;
    property SLeft: integer read FSLeft write FSLeft;
    property STop: integer read FSTop write FSTop;
  published
    { published declarations }
    property VX: integer read FVX write SetVX;
    property VY: integer read FVY write SetVY;
    property OnMove: TSpriteMoveEvent read FOnMove write SetOnMove;
    property OnBounce: TNotifyEvent read FOnBounce write SetOnBounce;
    property AndImage;
    property OrImage;
    property Enabled;
  end;

procedure Register;

implementation

{$IFDEF WIN32}
  {$R SPRITES.D32}
{$ELSE}
  {$R SPRITES.D16}
{$ENDIF}

{ TCustomSprite base class }
constructor TCustomSprite.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { create bitmap instances }
  FAndImage := TBitmap.Create;
  FOrImage := TBitmap.Create;
  Width := 60;
  Height := 60;
end;

destructor TCustomSprite.Destroy;
begin
  { free bitmap instances }
  FAndImage.Free;
  FOrImage.Free;
  inherited Destroy;
end;

procedure TCustomSprite.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  { SetBounds sets the component bounds to the size of the
  image if an image is loaded. }
  if (FAndImage.Width > 0) and (FAndImage.Height > 0) then
    inherited SetBounds(ALeft, ATop, FAndImage.Width, FAndImage.Height)
  else inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TCustomSprite.SetAndImage(AAndImage: TBitmap);
begin
  {Copy And image data from source bitmap}
  FAndImage.Assign(AAndImage);
  { set size }
  Width := AndImage.Width;
  Height := AndImage.Height;
  Invalidate;
end;

procedure TCustomSprite.SetOrImage(AOrImage: TBitmap);
begin
  {Copy Or image data from source bitmap}
  FOrImage.Assign(AOrImage);
  { set size }
  Width := OrImage.Width;
  Height := OrImage.Height;
  Invalidate;
end;

procedure TCustomSprite.Paint;
begin
  { Paint the component as a dashed clear box at design
    time. Do nothing at run time. }
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
end;

{ TSprite }

constructor TSprite.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  { Initiallize acceleration fields }
  FVX := 0;
  FVY := 0;
end;

{ set sprite position equal to component
  position AFTER component is loaded }
procedure TSprite.Loaded;
begin
  SLeft := Left;
  STop := Top;
end;

{ SetVX - if the value is -1, 0 or 1 then set the direction
  vector. This indicates a bounce condition
  in most cases so create an OnBounce event }
procedure TSprite.SetVX(Value: integer);
begin
  if (Value >= -1) and (Value <= 1) then
  begin
    FVX := Value;
    if Assigned(FOnBounce) then OnBounce(Self);
  end;
end;

{ SetVY - if the value is -1, 0 or 1 then set the direction
  vector. This indicates a bounce condition
  in most cases so create an OnBounce event }
procedure TSprite.SetVY(Value: integer);
begin
  if (Value >= -1) and (Value <= 1) then
  begin
    FVY := Value;
    if Assigned(FOnBounce) then OnBounce(Self);
  end;
end;

procedure TSprite.SetOnMove(Value: TSpriteMoveEvent);
begin
  FOnMove := Value;
end;

procedure TSprite.SetOnBounce(Value: TNotifyEvent);
begin
  FOnBounce := Value;
end;

{ Paint - the component as a dashed clear box the
  size of any loaded image, with the image rendered,
  at design time. Do nothing at run time. }
procedure TSprite.Paint;
begin
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
      CopyMode := cmSrcAnd;
      CopyRect(ClientRect,FANDImage.Canvas,ClientRect);
      CopyMode := cmSrcPaint;
      CopyRect(ClientRect,FORImage.Canvas,ClientRect);
    end;
end;

{ MoveSprite - set bounds to the size and LOCATION of the
  image. Trigger an OnMove event. Set the location
  of the sprite to any changed value of bounds. }
procedure TSprite.MoveSprite;
var
  Bounds: TRect;
begin
  Bounds := Rect(SLeft,STop,SLeft+Width,STop+Height);
  if Assigned(FOnMove) then OnMove(Self, Bounds);
  SLeft := Bounds.Left;
  STop := Bounds.Top;
end;

{ register component on Misc page }
procedure Register;
begin
  RegisterComponents('Misc', [TSprite]);
end;

end.